Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Applications/NIH Image 1.55/Source/PlugIns.p

Text File | 1994-05-04 | 25.6 KB | 985 lines | [TEXT/PJMM]

unit PlugIns;
{This unit for utilizing Adobe Photoshop compatible acquisition, export and filter plug-ins}
{is based on code written by Greg Brown, Steven Gonzalo and Richard Ohlendorf.}
{Ohlendorf Research, Inc.}
{818 LaSalle Street}
{Ottawa, IL 61350}
{815-434-5622}
{[e-mail]}

interface
    uses
        QuickDraw, Palettes, QDOffscreen, PrintTraps, Globals, utilities, Graphics, Lut, Filters, Stacks, File1, File2;

    procedure RunAcqPlugIn (item: integer);
    procedure LoadAcqPlugIn (FileName: str255);
    procedure RunExportPlugIn (item: integer);
    procedure RunFilterPlugIn (item: integer);
    procedure LoadFilterPlugIn (FileName: str255);


implementation

    type
        MonitorRec = record
                gamma: Fixed;
                redX: Fixed;
                redY: Fixed;
                greenX: Fixed;
                greenY: Fixed;
                blueX: Fixed;
                blueY: Fixed;
                whiteX: Fixed;
                whiteY: Fixed;
                ambient: Fixed;
            end;

        PlaneMapType = array[0..15] of integer;

        AcquireRecord = record
                serialNumber: LongInt;
                abortProc: ProcPtr;
                progressProc: ProcPtr;
                maxData: LongInt;
                imageMode: integer;
                fImageSize: Point;
                depth: integer;
                planes: integer;
                imageHRes: Fixed;
                imageVRes: Fixed;
                rLUT: packed array[0..255] of char;
                gLUT: packed array[0..255] of char;
                bLUT: packed array[0..255] of char;
                data: Ptr;
                theRect: Rect;
                loPlane: integer;
                hiPlane: integer;
                colBytes: integer;
                rowBytes: LongInt;
                planeBytes: LongInt;
                FileName: Str255;
                vRefNum: integer;
                dirty: boolean;
         {Version 4 fields}
                hostSig: OSType;
                hostProc: ProcPtr;
                hostModes: LongInt;
                planeMap: PlaneMapType;
                canTranspose: boolean;
                needTranspose: boolean;
                duotoneInfo: Handle;
                diskSpace: LongInt;
                spaceProc: ProcPtr;
                monitor: MonitorRec;
                reserved: packed array[0..255] of char;
            end;

        FilterColor = packed array[0..3] of char;

        FilterRecord = record
                serialNumber: LongInt;
                abortProc: ProcPtr;
                progressProc: ProcPtr;
                parameters: Handle;
                fImageSize: Point;
                planes: integer;
                filterRect: Rect;
                background: RGBColor;
                foreground: RGBColor;
                maxSpace: LongInt;
                bufferSpace: LongInt;
                inRect: Rect;
                inLoPlane: integer;
                inHiPlane: integer;
                outRect: Rect;
                outLoPlane: integer;
                outHiPlane: integer;
                inData: Ptr;
                inRowBytes: LongInt;
                outData: Ptr;
                outRowBytes: LongInt;
                isFloating: boolean;
                haveMask: boolean;
                autoMask: boolean;
                maskRect: Rect;
                maskData: Ptr;
                maskRowBytes: LongInt;
         {Version 4 fields}
                backColor: FilterColor;
                foreColor: FilterColor;
                hostSig: OSType;
                hostProc: ProcPtr;
                imageMode: integer;
                imageHRes: Fixed;
                imageVRes: Fixed;
                floatCoord: Point;
                wholeSize: Point;
                monitor: MonitorRec;
                reserved: packed array[0..255] of char;
            end;


        ExportRecord = record
                serialNumber: LongInt;
                abortProc: ProcPtr;
                progressProc: ProcPtr;
                maxData: LongInt;
                imageMode: integer;
                eImageSize: Point;
                depth: integer;
                planes: integer;
                imageHRes: Fixed;
                imageVRes: Fixed;
                rLUT: packed array[0..255] of char;
                gLUT: packed array[0..255] of char;
                bLUT: packed array[0..255] of char;
                theRect: Rect;
                loPlane: integer;
                hiPlane: integer;
                data: Ptr;
                rowBytes: LongInt;
                filename: Str255;
                vRefNum: integer;
                dirty: BOOLEAN;
                selectBBox: Rect;
        {Version 4 fields }
                hostSig: OSType;
                hostProc: ProcPtr;
                duotoneInfo: Handle;
                thePlane: integer;
                monitor: MonitorRec;
                reserved: packed array[0..255] of char;
            end;


    var
        acqData, exportData, filterData, nlines, rowpix: LongInt;
        disppict, srcpict: ptr;
        refnum: integer;
        ShowProgress: boolean;
        ProgressMsg: string[17];
        FilterRec: FilterRecord;


    procedure DummyProc;
    begin
    end;

    function TestAbort: boolean;
    begin
        if commandperiod then
            testabort := true
        else
            testabort := false;
    end;


    procedure UpdateProgress (done, total: LongInt);
        var
            whatpercent: integer;
    begin
        if ShowProgress and (done > 0) and (total > 0) and (total >= done) then begin
                whatpercent := round((done / total) * 100);
                UpdateMeter(whatpercent, ProgressMsg);
            end;
    end;



    procedure CopyData (src: ptr; theRect: rect; srcRowBytes, dstRowBytes: LongInt; lines: integer);
        var
            i: integer;
            dst: ptr;
            width: LongInt;
    begin
        with theRect do
            width := right - left;
        with info^ do
            dst := ptr(ord4(PicBaseAddr) + LongInt(therect.top) * BytesPerRow + therect.left);
        for i := 0 to lines - 1 do begin
                BlockMove(src, dst, width);
                src := ptr(ord4(src) + srcRowBytes);
                dst := ptr(ord4(dst) + dstRowBytes);
            end;
    end;


    procedure CopyInterleavedRGBData (src: ptr; theRect: rect; srcRowBytes, dstRowBytes, colBytes: LongInt; lines: integer; planeMap: PlaneMapType);
        var
            i, j, slice, plane, width: integer;
            src2, src3, dst2, dst3: ptr;
    begin
        with theRect do
            width := right - left;
        with info^.StackInfo^ do
            for slice := 1 to 3 do begin
                    CurrentSlice := slice;
                    SelectSlice(slice);
                    plane := planeMap[slice - 1];
                    src2 := src;
                    dst2 := ptr(ord4(info^.PicBaseAddr) + LongInt(therect.top) * info^.BytesPerRow + therect.left);
                    for i := 0 to lines - 1 do begin
                            src3 := ptr(ord4(src2) + plane);
                            dst3 := dst2;
                            for j := 0 to width - 1 do begin
                                    dst3^ := src3^;
                                    src3 := ptr(ord4(src3) + colBytes);
                                    dst3 := ptr(ord4(dst3) + 1);
                                end;
                            src2 := ptr(ord4(src2) + srcRowBytes);
                            dst2 := ptr(ord4(dst2) + dstRowBytes);
                        end; {for i:=1 to nlines-1}
                end; {for slice:=1 to 3}
    end;


    procedure CopyPlanarRGBData (src: ptr; theRect: rect; srcRowBytes, dstRowBytes, planeBytes: LongInt; lines, loPlane, hiPlane: integer);
        var
            i, j, slice, plane: integer;
            src2, dst2: ptr;
            width: LongInt;
    begin
        with theRect do
            width := right - left;
        if loPlane = hiPlane then
            planeBytes := 0;
        if (planeBytes < 0) or (planeBytes > srcRowBytes) then
            planeBytes := width;
        with info^.StackInfo^ do
            for plane := loPlane to hiPlane do begin
                    slice := plane + 1;
                    if slice > 3 then
                        slice := 3;
                    CurrentSlice := slice;
                    SelectSlice(slice);
                    src2 := ptr(ord4(src) + planeBytes * plane);
                    dst2 := ptr(ord4(info^.PicBaseAddr) + LongInt(therect.top) * info^.BytesPerRow + therect.left);
                    for i := 0 to lines - 1 do begin
                            BlockMove(src2, dst2, width);
                            src2 := ptr(ord4(src2) + srcRowBytes);
                            dst2 := ptr(ord4(dst2) + dstRowBytes);
                        end;
                end;
    end;


    function MakeRGBStack (name: str255; width, height: integer): boolean;
        var
            ignore: integer;
    begin
        MakeRGBStack := false;
        if not NewPicWindow('RGB', width, height) then
            exit(MakeRGBStack);
        if not MakeStackFromWindow then
            exit(MakeRGBStack);
        if not AddSlice(false) then begin
                info^.changes := false;
                ignore := CloseAWindow(info^.wptr);
                exit(MakeRGBStack);
            end;
        if not AddSlice(false) then begin
                info^.changes := false;
                ignore := CloseAWindow(info^.wptr);
                exit(MakeRGBStack);
            end;
        MakeRGBStack := true;
    end;

    procedure GetSFCurDir (var vRefNum: integer; var DirID: LongInt);
  {From "Inside Macintosh:Files", page 3-31.}
        type
            IntPtr = ^integer;
            LongIntPtr = ^LongInt;
        const
            SFSaveDisk = $214;
            CurDirStore = $398;
    begin
        vRefNum := -IntPtr(SFSaveDisk)^;
        DirID := LongIntPtr(CurDirStore)^;
    end;

    procedure SetSFCurDir (vRefNum: integer; DirID: LongInt);
        type
            IntPtr = ^integer;
            LongIntPtr = ^LongInt;
        const
            SFSaveDisk = $214;
            CurDirStore = $398;
    begin
        IntPtr(SFSaveDisk)^ := -vRefNum;
        LongIntPtr(CurDirStore)^ := dirID;
    end;


    function isSystem7: boolean;
    begin
        if not System7 then {These routines uses File Manager calls only available under System 7.}
            PutMessage('System 7 required to use plug-ins.');
        isSystem7 := System7;
    end;


    procedure LoadCodeResource (FileName: str255; fType: osType; var codePtr: ProcPtr);
        var
            myReply: StandardFileReply;
            myTypes: SFTypeList;
            err: OSErr;
            CodeResource: handle;
            GotSpec: boolean;
            spec: FSSpec;
            SaveVol: integer;
            SaveDir: LongInt;
    begin
        GotSpec := false;
        if FileName <> '' then begin
                err := FSMakeFSSpec(PluginsVRefNum, PluginsDirID, FileName, spec);
                GotSpec := err = noerr;
            end;
        if not GotSpec then begin
                GetSFCurDir(SaveVol, SaveDir);
                if PluginsVRefNum <> 0 then
                    SetSFCurDir(PluginsVRefNum, PluginsDirID);
                myTypes[0] := fType;
                StandardGetFile(nil, 1, myTypes, myReply);
                if myReply.sfGood then begin
                        spec := myReply.sfFile;
                        FileName := myReply.sfFile.name;
                        GotSpec := true
                    end;
                GetSFCurDir(PluginsVRefNum, PluginsDirID);
                SetSFCurDir(SaveVol, SaveDir);
            end;
        if GotSpec then begin
                refnum := FSpOpenResFile(spec, fsCurPerm);
                if (refnum <> -1) then begin
                        if fType = '8BAM' then begin {Acquistion plug-in}
                                if pos('Raster', FileName) <> 0 then {Can't show progress indicator if RasterOps frame grabber.}
                                    ShowProgress := false;
                                if FileName <> LastAcqPlugIn then
                                    acqData := 0;
                                LastAcqPlugIn := FileName;
                            end
                        else if fType = '8BFM' then begin  {Filter plug-in}
                                if FileName <> LastFilterPlugIn then begin
                                        filterData := 0;
                                        FilterRec.parameters := nil;
                                    end;
                                LastFilterPlugIn := FileName;
                            end
                        else if fType = '8BEM' then begin  {Export plug-in}
                                if FileName <> LastExportPlugIn then
                                    exportData := 0;
                                LastExportPlugIn := FileName;
                            end;
                        UseResFile(refnum);
                        codeResource := GetIndResource(fType, 1);
                        hlock(codeResource);
                        codePtr := ProcPtr(codeResource^);
                    end
                else
                    PutMessage(concat('Error opening plug-in. (Code=', Long2Str(ResError), ')'));
            end;
    end;


    procedure CallCode (selector: integer; AcqRec: ptr; var data: LongInt; var result: Integer; codePtr: ProcPtr);
    inline
        $205F,   {move.l (a7)+,a0}
        $4E90;   {jsr (a0)}


    procedure LoadAcqPlugIn (FileName: str255);

        const
            AcquireAbout = 0;
            AcquireStart = 1;
            AcquireContinue = 2;
            AcquireFinish = 3;
            AcquirePrepare = 4;

            BitMapMode = 0;
            GrayScaleMode = 1;
            IndexedColorMode = 2;
            RGBColorMode = 3;

        var
            thiserror: qderr;
            codePtr: ProcPtr;
            AcqRec: acquirerecord;
            result, i, selector, width, height, ignore: integer;
            ok: boolean;
            dst: ptr;
            name: str255;

        procedure ShowInfo (str: str255);
        begin
            with AcqRec do
                if ControlKeyDown then begin
                        str := concat(str, cr, cr, 'imageMode=', long2str(imageMode));
                        str := concat(str, cr, 'width=', long2str(therect.right - therect.left));
                        str := concat(str, cr, 'height=', long2str(therect.bottom - therect.top));
                        str := concat(str, cr, 'depth=', long2str(depth));
                        str := concat(str, cr, 'planes=', long2str(planes));
                        str := concat(str, cr, 'colBytes=', long2str(colBytes));
                        str := concat(str, cr, 'rowBytes=', long2str(rowBytes));
                        str := concat(str, cr, 'planeBytes=', long2str(planeBytes));
                        str := concat(str, cr, 'planeMap=', long2str(planeMap[0]), ' ', long2str(planeMap[1]), long2str(planeMap[2]), ' ', long2str(planeMap[3]));
                        str := concat(str, cr, 'loPlane=', long2str(loPlane));
                        str := concat(str, cr, 'hiPlane=', long2str(hiPlane));
                        ShowMessage(str);
                    end;
        end;

        procedure CopyLUT;
            var
                i: integer;
        begin
            with info^ do begin
                    for i := 0 to 255 do
                        with cTable[i], cTable[i].rgb, AcqRec do begin
                                value := 0;
                                red := bsl(ord(rLUT[255 - i]), 8);
                                green := bsl(ord(gLUT[255 - i]), 8);
                                blue := bsl(ord(bLUT[255 - i]), 8);
                            end;
                    LoadLUT(cTable);
                    SetupPseudocolor;
                    LutMode := ColorLUT;
                    IdentityFunction := false;
                    UpdateMap;
                end
        end;

        procedure abort (error: integer; started: boolean);
            var
                msg: str255;
        begin
            if started then
                CallCode(AcquireFinish, @AcqRec, acqData, result, codePtr);
            CloseResFile(RefNum);
            if MeterWindow <> nil then begin
                    DisposeWindow(MeterWindow);
                    MeterWindow := nil;
                end;
            if error < 0 then begin
                    msg := '';
                    if error = -108 then
                        msg := concat(cr, cr, '"', 'Not enough memory', '"');
                    PutMessage(concat('Plug-in error (result code=', long2str(error), ')', msg));
                end;
            PicLeft := PicLeftBase;
            PicTop := PicTopBase;
            macro := false;
            exit(LoadAcqPlugIn);
        end;

    begin
        if not isSystem7 then
            exit(LoadAcqPlugIn);
        ShowProgress := true;
        codePtr := nil;
        LoadCodeResource(FileName, '8BAM', codePtr);
        if codePtr = nil then
            exit(LoadAcqPlugIn);
        with AcqRec do begin
                SerialNumber := 12345;
                AbortProc := @TestAbort;
                ProgressProc := @UpdateProgress;
                MaxData := maxBlock div 2;
                if MaxData < 25000 then begin
                        PutMessage('Out of memory.');
                        abort(0, false);
                    end;
                imageHRes := 0;
                hostSig := 'Imag';
                hostProc := @DummyProc;
                hostModes := 14;{=1110, i.e., grayscale, indexed color and RGB}
                for i := 0 to 15 do begin
                        planemap[i] := i;
                    end;
                FileName := '';
                canTranspose := false;
                needTranspose := false;
                duoToneInfo := nil;
                diskSpace := -1;
                spaceProc := nil;
                monitor.gamma := 0;
                for i := 0 to 255 do
                    reserved[i] := chr(0);
            end;
        ProgressMsg := 'Acquiring Image…';
        ShowInfo('Acquire');
        CallCode(AcquirePrepare, @AcqRec, acqData, result, codePtr);
        if (result <> 0) then
            abort(result, false);
        ShowInfo('start');
        CallCode(AcquireStart, @AcqRec, acqData, result, codePtr);{call main dialog box etc.}
        if (result <> 0) then
            abort(result, false);
        if AcqRec.depth = 1 then begin
                PutMessage('NIH Image does not support acquisition of bitmap (black and white) images.');
                abort(0, true);
            end;
        ShowInfo('Opening');
        OpeningPlugInWindow := true; {Causes MakeNewWindow to open window offscreen.}
        if AcqRec.ImageMode = RGBColorMode then
            ok := MakeRGBStack('Untitled', AcqRec.fImageSize.h, AcqRec.fImageSize.v)
        else begin
                if FileName <> '' then
                    name := FileName
                else
                    name := 'Untitled';
                ok := NewPicWindow(name, AcqRec.fImageSize.h, AcqRec.fImageSize.v);
            end;
        OpeningPlugInWindow := false;
        if not ok then begin
                ShowInfo('Aborting');
                abort(0, true);
            end;
        with info^, AcqRec do
            if ImageMode = GrayScaleMode then begin
                    if LUTMode = ColorLUT then
                        ResetGrayMap
                end
            else if ImageMode = RGBColorMode then
                ResetGrayMap
            else if ImageMode = IndexedColorMode then begin
                    ShowInfo('CopyLUT');
                    CopyLUT;
                end;
        ShowWatch;
        repeat
      {ShowInfo('Continue');}
            CallCode(AcquireContinue, @AcqRec, acqData, result, codePtr);
            if result <> 0 then begin
                    info^.changes := false;
                    ignore := CloseAWindow(info^.wptr);
                    abort(result, true);
                end;
            with AcqRec do
                if data <> nil then begin
                        width := therect.right - therect.left;
                        height := therect.bottom - therect.top;
             {ShowInfo('Continue');}
                        with Info^ do
                            if ((therect.left + width) <= PixelsPerLine) and (therect.top < nlines) then begin
                                    if (ImageMode = RGBColorMode) and (planes >= 3) and ((hiPlane - loPlane) < 3) then begin
                                            if planeBytes = 1 then
                                                CopyInterleavedRGBData(data, theRect, rowBytes, Info^.BytesPerRow, colBytes, height, planeMap)
                                            else
                                                CopyPlanarRGBData(data, theRect, rowBytes, Info^.BytesPerRow, planeBytes, height, loPlane, hiPlane)
                                        end
                                    else
                                        CopyData(data, theRect, rowBytes, Info^.BytesPerRow, height);
                                end;
                    end;
        until (result <> 0) or (AcqRec.data = nil);
        CallCode(AcquireFinish, @AcqRec, acqData, result, codePtr);
        CloseResFile(RefNum);
        if MeterWindow <> nil then begin
                DisposeWindow(MeterWindow);
                MeterWindow := nil;
            end;
        MoveWindow(info^.wptr, PicLeft, PicTop, true);
        if AcqRec.imageHRes <> 0 then
            with info^ do begin
                    xSpatialScale := FixRound(AcqRec.imageHRes);
                    ySpatialScale := xSpatialScale;
                    PixelAspectRatio := 1.0;
                    xUnit := 'inch';
                    SpatiallyCalibrated := true;
                    UpdateTitleBar;
                end;
        if info^.StackInfo <> nil then
            with info^.StackInfo^ do begin
                    for i := nSlices downto 1 do begin
                            CurrentSlice := i;
                            SelectSlice(CurrentSlice);
                            InvertPic;
                        end;
                    UpdateTitleBar;
                    ConvertRGBToEightBitColor(true);
                end
        else
            InvertPic;
        if AcqRec.ImageMode = IndexedColorMode then begin
                FixColors;
                WhatToUndo := NothingToUndo;
            end;
        Info^.changes := true;
    end; {LoadAcqPlugIn}


    procedure PutPlugInMsg (str: str255);
        var
            str2: str255;
    begin
        if System7 then
            PutMessage(concat(str, ' plug-ins found. Plug-ins must be in a folder named "Plug-ins" located in either the same folder as NIH Image or in the System Folder.'))
        else
            PutMessage('System 7 required to use plug-ins.');
    end;


    procedure RunAcqPlugIn (item: integer);
        var
            name: str255;
    begin
        if nAcqPlugIns = 0 then begin
                PutPlugInMsg('No acquisition');
                exit(RunAcqPlugIn);
            end;
        GetItem(AcquireMenuH, item, name);
        LoadAcqPlugIn(name);
    end;


    procedure LoadExportPlugIn (FileName: str255);

        const
            ExportAbout = 0;
            ExportStart = 1;
            ExportContinue = 2;
            ExportFinish = 3;
            ExportPrepare = 4;

            BitMapMode = 0;
            GrayScaleMode = 1;
            IndexedColorMode = 2;
            RGBColorMode = 3;

        var
            thiserror: qderr;
            codePtr: ProcPtr;
            ExportRec: ExportRecord;
            result, i, selector, width, height: integer;
            ok: boolean;
            dst: ptr;
            roi, empty: rect;
            offset: LongInt;

        procedure ShowInfo (str: str255);
        begin
            with ExportRec do
                if ControlKeyDown then begin
                        str := concat(str, cr, cr, 'imageMode=', long2str(imageMode));
                        str := concat(str, cr, 'width=', long2str(therect.right - therect.left));
                        str := concat(str, cr, 'height=', long2str(therect.bottom - therect.top));
                        str := concat(str, cr, 'depth=', long2str(depth));
                        str := concat(str, cr, 'planes=', long2str(planes));
                        str := concat(str, cr, 'rowBytes=', long2str(rowBytes));
                        str := concat(str, cr, 'loPlane=', long2str(loPlane));
                        str := concat(str, cr, 'hiPlane=', long2str(hiPlane));
                        ShowMessage(str);
                    end;
        end;

        function BadRect: boolean;
        begin
            BadRect := false;
            with info^.PicRect do begin
                    if (ExportRec.theRect.left < left) or (exportRec.theRect.right > right) or (exportRec.theRect.top < top) or (exportRec.theRect.bottom > bottom) then
                        BadRect := true;
                end;
        end;

        procedure abort (result: integer);
        begin
            CloseResFile(RefNum);
            if MeterWindow <> nil then begin
                    DisposeWindow(MeterWindow);
                    MeterWindow := nil;
                end;
            InvertPic;
            if result < 0 then
                PutMessage(concat('Plug-in error(result code=', long2str(result), ').'));
            exit(LoadExportPlugIn);
        end;

    begin
        if not isSystem7 then
            exit(LoadExportPlugIn);
        SetRect(empty, 0, 0, 0, 0);
        with info^ do
            if RoiShowing then
                roi := RoiRect
            else
                roi := empty;
        ShowProgress := true;
        codePtr := nil;
        LoadCodeResource(FileName, '8BEM', codePtr);
        if codePtr = nil then
            exit(LoadExportPlugIn);
        InvertPic;
        with ExportRec, info^ do begin
                SerialNumber := 12345;
                AbortProc := @TestAbort;
                ProgressProc := @UpdateProgress;
                MaxData := maxBlock div 2;
                if MaxData < 25000 then begin
                        PutMessage('Out of memory.');
                        abort(0);
                    end;
                if LUTMode = Grayscale then
                    ImageMode := GrayScaleMode
                else
                    ImageMode := IndexedColorMode;
                with PicRect, eImageSize do begin
                        h := right - left;
                        v := bottom - top;
                    end;
                depth := 8;
                planes := 1;
                imageHRes := bsl(72, 16);
                imageVRes := imageHRes;
                for i := 0 to 255 do
                    with cTable[i].rgb do begin
                            rLUT[255 - i] := chr(bsr(red, 8));
                            gLUT[255 - i] := chr(bsr(green, 8));
                            bLUT[255 - i] := chr(bsr(blue, 8));
                        end;
                theRect := empty;
                loPlane := 0;
                hiPlane := 0;
                data := PicBaseAddr;
                rowBytes := BytesPerRow;
                FileName := title;
                vRefNum := vRef;
                dirty := changes;
                selectBBox := roi;
                hostSig := 'Imag';
                hostProc := @DummyProc;
                duoToneInfo := nil;
                thePlane := 0;
                monitor.gamma := 0;
                for i := 0 to 255 do
                    reserved[i] := chr(0);
            end;
        ProgressMsg := 'Exporting Image…';
        CallCode(ExportPrepare, @ExportRec, ExportData, result, codePtr);
        if (result <> 0) then
            abort(result);
        CallCode(ExportStart, @ExportRec, ExportData, result, codePtr);{call main dialog box etc.}
        if (result <> 0) then
            abort(result);
        ShowWatch;
        repeat
            if BadRect then
                abort(0);
            with ExportRec, info^ do begin
                    offset := LongInt(theRect.top) * BytesPerRow + theRect.left;
                    data := ptr(ord4(PicBaseAddr) + offset);
                end;
            CallCode(exportContinue, @exportRec, exportData, result, codePtr);
        until (result <> 0) or EmptyRect(exportRec.theRect);
        CallCode(ExportFinish, @ExportRec, ExportData, result, codePtr);
        CloseResFile(RefNum);
        if MeterWindow <> nil then begin
                DisposeWindow(MeterWindow);
                MeterWindow := nil;
            end;
        InvertPic;
    end;


    procedure RunExportPlugIn (item: integer);
        var
            name: str255;
    begin
        if nExportPlugIns = 0 then begin
                PutPlugInMsg('No export');
                exit(RunExportPlugIn);
            end;
        GetItem(ExportMenuH, item, name);
        LoadExportPlugIn(name);
    end;


    procedure LoadFilterPlugIn (FileName: str255);

        const
            filterAbout = 0;
            filterParameters = 1;
            filterPrepare = 2;
            filterStart = 3;
            filterContinue = 4;
            filterFinish = 5;

            GrayScaleMode = 1;

        var
            thiserror: qderr;
            codePtr: ProcPtr;
            result, i, selector, width, height: integer;
            ok: boolean;
            dst: ptr;
            Empty, roi: rect;
            offset: LongInt;

        procedure InvertUndoPic;
            var
                tPort: GrafPtr;
                SaveGDevice: GDHandle;
        begin
            SaveGDevice := GetGDevice;
            SetGDevice(osGDevice);
            GetPort(tPort);
            with UndoInfo^ do begin
                    SetPort(GrafPtr(osPort));
                    InvertRect(PicRect);
                end;
            SetPort(tPort);
            SetGDevice(SaveGDevice);
        end;

        procedure abort;
        begin
            CloseResFile(RefNum);
            InvertPic;
            InvertUndoPic;
            if MeterWindow <> nil then begin
                    DisposeWindow(MeterWindow);
                    MeterWindow := nil;
                end;
            exit(LoadFilterPlugIn);
        end;

        function BadRect: boolean;
        begin
            BadRect := false;
            with info^.PicRect do begin
                    if (FilterRec.inRect.left < left) or (FilterRec.inRect.right > right) or (FilterRec.inRect.top < top) or (FilterRec.inRect.bottom > bottom) then
                        BadRect := true;
                    if (FilterRec.outRect.left < left) or (FilterRec.outRect.right > right) or (FilterRec.outRect.top < top) or (FilterRec.outRect.bottom > bottom) then
                        BadRect := true;
                end;
        end;

    begin {LoadFilterPlugIn}
        if not isSystem7 then
            exit(LoadFilterPlugIn);
        if macro then
            if FileName = 'Reset' then begin
                    FilterRec.parameters := nil;
                    exit(LoadFilterPlugIn);
                end;
        if NotInBounds or NoUndo or NotRectangular then
            exit(LoadFilterPlugIn);
        with info^ do
            if RoiShowing then
                roi := RoiRect
            else
                roi := PicRect;
        KillRoi;
        SetupUndo;
        SetupUndoInfoRec;
        InvertPic;
        InvertUndoPic;
        WhatToUndo := UndoFilter;
        ShowProgress := true;
        codePtr := nil;
        LoadCodeResource(FileName, '8BFM', codePtr);
        if codePtr = nil then
            exit(LoadFilterPlugIn);
        SetRect(Empty, 0, 0, 0, 0);
        with FilterRec, info^ do begin
                serialnumber := 12345;
                AbortProc := @TestAbort;
                ProgressProc := @UpdateProgress;
                with PicRect, fImageSize do begin
                        h := right - left;
                        v := bottom - top;
                    end;
                planes := 1;
                filterRect := roi;
                background := WhiteRGB;
                foreground := BlackRGB;
                maxSpace := PixMapSize;
                bufferSpace := 0;
                inRect := Empty;
                inLoPlane := 0;
                inHiPlane := 0;
                outRect := Empty;
                outLoPlane := 0;
                outHiPlane := 0;
                inData := UndoBuf;
                inRowBytes := BytesPerRow;
                outData := PicBaseAddr;
                outRowBytes := BytesPerRow;
                isFloating := false;
                haveMask := false;
                autoMask := false;
                maskRect := Empty;
                maskData := nil;
                maskRowBytes := BytesPerRow;
                for i := 0 to 3 do begin
                        backColor[i] := chr(BackgroundIndex);
                        foreColor[i] := chr(ForegroundIndex);
                    end;
                hostSig := 'Imag';
                hostProc := @DummyProc;
                imageMode := GrayScaleMode;
                imageHRes := bsl(72, 16);
                imageVRes := imageHRes;
                floatCoord.h := 0;
                floatCoord.v := 0;
                wholeSize := fImageSize;
                monitor.gamma := 0;
                for i := 0 to 255 do
                    reserved[i] := chr(0);
            end;
        ProgressMsg := 'Filtering Image…';
        if not (macro and (FilterRec.parameters <> nil)) then begin
                CallCode(FilterParameters, @FilterRec, filterData, result, codePtr);
                if result <> 0 then
                    abort;
            end;
        CallCode(FilterPrepare, @FilterRec, filterData, result, codePtr);
        if result <> 0 then
            abort;
        if FilterRec.bufferSpace > (MaxBlock + MinFree) then begin
                PutMessage('Not enough memory to run filter.');
                abort;
            end;
        CallCode(FilterStart, @FilterRec, filterData, result, codePtr);
        if result <> 0 then
            abort;
        ShowWatch;
        repeat
            if BadRect then
                abort;
            with FilterRec, info^ do begin
                    offset := LongInt(inRect.top) * BytesPerRow + inRect.left;
                    inData := ptr(ord4(UndoBuf) + offset);
                    offset := LongInt(outRect.top) * BytesPerRow + outRect.left;
                    outData := ptr(ord4(PicBaseAddr) + offset);
                end;
            CallCode(filterContinue, @FilterRec, filterData, result, codePtr);
        until (result <> 0) or (EmptyRect(FilterRec.inRect) and EmptyRect(FilterRec.outRect));
        CallCode(filterFinish, @FilterRec, filterData, result, codePtr);
        CloseResFile(RefNum);
        if MeterWindow <> nil then begin
                DisposeWindow(MeterWindow);
                MeterWindow := nil;
            end;
        InvertPic;
        InvertUndoPic;
        UpdatePicWindow;
        info^.changes := true;
    end;


    procedure RunFilterPlugIn (item: integer);
        var
            name: str255;
    begin
        if nFilterPlugIns = 0 then begin
                PutPlugInMsg('No filter');
                exit(RunFilterPlugIn);
            end;
        GetItem(FilterMenuH, item, name);
        LoadFilterPlugIn(name);
    end;


end.